module Process where

import System.IO
import System.Posix.Types
import System.Posix.Process
import System.Posix.IO
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Exception.Base (catch, IOException)
import Syntax

type CloseFds = MVar [Fd]

data CommandResult = CommandResult
  { cmdOutput :: IO String
  , getExitStatus :: IO ProcessStatus
  }

class Invokable a where
  invoke :: a -> CloseFds -> String -> IO CommandResult

instance Invokable Pipeline where
  invoke (Command cmd args) closeFds input = do
    (stdinRead, stdinWrite) <- createPipe
    (stdoutRead, stdoutWrite) <- createPipe

    -- add parent Fds to close list because they must always closed in the child
    addCloseFds closeFds [stdinWrite, stdoutRead]

    -- fork child process
    childPID <- withMVar closeFds (\fds -> forkProcess (child fds stdinRead stdoutWrite))

    -- close unused fds in parent process
    closeFd stdinRead
    closeFd stdoutWrite

    -- write input from parent to child
    stdinHdl <- fdToHandle stdinWrite
    forkIO $ hPutStr stdinHdl input >> hClose stdinHdl

    -- recieve output from child
    stdoutHdl <- fdToHandle stdoutRead
    return $ CommandResult { cmdOutput = hGetContents stdoutHdl
                           , getExitStatus = waitPipe childPID closeFds stdinWrite stdoutRead
                           }
    where
      child closeFds stdinRead stdoutWrite = do
        -- connect the child input/output pipes to standard I/O.
        dupTo stdinRead stdInput
        dupTo stdoutWrite stdOutput
        -- close child's fds
        closeFd stdinRead
        closeFd stdoutWrite

        -- close open FDs that were inherited from the parent.
        mapM_ (\fd -> catch (closeFd fd) (\e -> putStrLn $ show (e :: IOException))) closeFds
        executeFile (getCmdName cmd) True (getCmdWord <$> args) Nothing

-- | wait on childPID and close FDs after when child finishes. Return the
-- ProcessStatus of this child to the caller.
waitPipe :: ProcessID -> CloseFds -> Fd -> Fd -> IO ProcessStatus
waitPipe childPID closeFds stdinWrite stdoutRead = do
  status <- getProcessStatus True False childPID
  case status of
    Nothing -> fail "Error: Nothin from getProcessStatus"
    Just ps -> removeCloseFds closeFds [stdinWrite, stdoutRead] >> return ps

-- | add FDs to list of FDs that must be closed in a child after a fork.
addCloseFds :: CloseFds -> [Fd] -> IO ()
addCloseFds closeFds newFds =
  modifyMVar_ closeFds (\oldFds -> return $ oldFds ++ newFds)

removeFirst :: Eq a => [a] -> a -> [a]
removeFirst [] _ = []
removeFirst (x:xs) a
  | x == a = xs
  | otherwise = x : removeFirst xs a

removeCloseFds :: CloseFds -> [Fd] -> IO ()
removeCloseFds closeFds toRemove =
  modifyMVar_ closeFds (\fds -> return $ foldl removeFirst fds toRemove)